home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TIPS / VALID.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-09  |  4KB  |  147 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Tips & Techniques Demo Program               }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program Valid;
  10.  
  11. {$R Valid}
  12.  
  13. uses WinTypes, WinProcs, WObjects, Strings;
  14.  
  15. const
  16.   FieldWidth = 6;
  17.  
  18. type
  19.   PEditInteger=^TEditInteger;
  20.   TEditInteger=object(TEdit)
  21.     constructor Init(AParent: PWindowsObject; AnId: Integer;
  22.       AValue: Integer; X, Y, W, H: Integer);
  23.     function CanClose: boolean; virtual;
  24.     function Transfer(DataPtr: Pointer; Transferflag: Word): Word; virtual;
  25.   end;
  26.  
  27. constructor TEditInteger.Init(AParent: PWindowsObject; AnId: Integer;
  28.   AValue: Integer; X, Y, W, H: Integer);
  29. var
  30.   InitValue: PChar;
  31.   TempStr: String;
  32. begin
  33.   GetMem(InitValue, FieldWidth + 1);
  34.   Str(AValue, TempStr);
  35.   StrPCopy(InitValue, TempStr);
  36.   TEdit.Init(AParent, AnId, InitValue, X, Y, W, H, FieldWidth, false);
  37.   FreeMem(InitValue, FieldWidth + 1);
  38. end;
  39.  
  40. function TEditInteger.Transfer(DataPtr: Pointer; Transferflag: Word): word;
  41. type
  42.   PInteger=^Integer;
  43. var
  44.   Value: PChar;
  45.   TempStr: String;
  46.   Result: Longint;
  47.   Code: Integer;
  48. begin
  49.   case Transferflag of
  50.   tf_GetData:
  51.     begin
  52.       GetMem(Value, TEdit.Transfer(nil, tf_SizeData));
  53.       TEdit.Transfer(Value, tf_GetData);
  54.       TempStr:=StrPas(Value);
  55.       Val(TempStr, Result, Code);
  56.       if code<>0 then
  57.         Transfer:=0
  58.       else
  59.       begin
  60.         if (Result>32767) or (Result<-32768) then
  61.           Transfer:=0
  62.         else
  63.         begin
  64.           PInteger(DataPtr)^:=Result;
  65.           Transfer:=SizeOf(Integer);
  66.         end;
  67.       end;
  68.     end;
  69.   tf_SetData:
  70.     begin
  71.       Str(PInteger(DataPtr)^, TempStr);
  72.       GetMem(Value, FieldWidth + 1);
  73.       StrPCopy(Value, TempStr);
  74.       TEdit.Transfer(Value, tf_SetData);
  75.       Transfer:=2;
  76.       FreeMem(Value, FieldWidth + 1);
  77.     end;
  78.   tf_SizeData: Transfer:=SizeOf(Integer);
  79.   end;
  80. end;
  81.  
  82. function TEditInteger.CanClose: boolean;
  83. var
  84.   Value:^Integer;
  85.   Result: Word;
  86. begin
  87.   New(Value);
  88.   Result:=Transfer(Value, tf_GetData);
  89.   if Result=0 then
  90.   begin
  91.     MessageBox(Application^.MainWindow^.HWindow, 'Integer Expected', nil,
  92.       mb_Ok or mb_IconStop);
  93.     SetFocus(HWindow);
  94.   end;
  95.   CanClose:=Result<>0;
  96. end;
  97.  
  98.  
  99. const
  100.   cm_Valid = 100;
  101.  
  102. type
  103.   PMainWindow = ^TMainWindow;
  104.   TMainWindow = object(TWindow)
  105.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  106.     procedure CMValid(var Msg: TMessage);
  107.       virtual cm_First + cm_Valid;
  108.   end;
  109.  
  110. constructor TMainWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  111. begin
  112.   TWindow.Init(AParent, ATitle);
  113.   Attr.Menu:=LoadMenu(HInstance,'MAINMENU');
  114. end;
  115.  
  116. procedure TMainWindow.CMValid(var Msg: TMessage);
  117. var
  118.   Dialog: PDialog;
  119.   EditInteger: PEditInteger;
  120.   Buffer: Integer;
  121. begin
  122.   New(Dialog, Init(@Self, 'Valid'));
  123.   EditInteger:=New(PEditInteger, InitResource(Dialog, 102, FieldWidth));
  124.   Buffer:=0;
  125.   Dialog^.TransferBuffer:=@Buffer;
  126.   Application^.ExecDialog(Dialog);
  127. end;
  128.  
  129. type
  130.   TApp = object(TApplication)
  131.     procedure InitMainWindow; virtual;
  132.   end;
  133.  
  134. procedure TApp.InitMainWindow;
  135. begin
  136.   MainWindow:=new(PMainWindow, Init(nil, 'Validate Integer'));
  137. end;
  138.  
  139. var
  140.   App: TApp;
  141.  
  142. begin
  143.   App.Init('Valid');
  144.   App.Run;
  145.   App.Done;
  146. end.
  147.